home *** CD-ROM | disk | FTP | other *** search
/ Loadstar 200 / 200.d81 / chain letters (.txt) < prev    next >
Commodore BASIC  |  2022-08-26  |  12KB  |  396 lines
  1. 10 dv=peek(186):ifdv<8thendv=8
  2. 30 print"[147]":poke53272,19:ad=49152:poke53280,0:poke53281,0
  3. 40 sys57812"chn font",dv,0:poke780,0:poke781,0:poke782,8:sys65493
  4. 45 gosub55:goto2300
  5. 53 :
  6. 54 rem --- setup program ---
  7. 55 dim lt(26),gr(12),uw$(220)
  8. 60 x=rnd(-ti):hq=0:ml=39777
  9. 70 pt$=chr$(255)+chr$(169):rem pointer
  10. 100 gs=1050:gr(1)=1227:gr(2)=1235
  11. 105 gr(3)=1243:gr(4)=1251:gr(5)=1259
  12. 110 lm=1827:return
  13. 148 :
  14. 149 rem --- game screen ---
  15. 150 print"[147] [192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192]"
  16. 155 forx=1to8:print"[151] [186] [180][180][180][180]  [186] [180][180][180][180]  [186] [180][180][180][180]  [186] [180][180][180][180]  [186] [180][180][180][180]":next
  17. 160 print" [192][192][192][192][192][192][156][193][194][195][196][197][198][199][200][201][202][203][204][205][206][207][208][209][210][211][212][213][214][215][216][217][218][192][192][192][192][192][192]"
  18. 165 gosub275:sysad+69
  19. 185 sysad+18,112:sysad+18,120:sysad+18,128:sysad+18,136:sysad+18,144
  20. 195 goto3100
  21. 198 :
  22. 199 rem ---- print custom-letter ----
  23. 200 pokepk,lt+64:pokepk+1,lt+128:pokepk+40,lt+96:pokepk+41,lt+160
  24. 210 cl=55296+(pk-1024)
  25. 220 pokecl,co:pokecl+1,co:pokecl+40,co:pokecl+41,co
  26. 225 return
  27. 228 :
  28. 229 rem --- clear custom letter ---
  29. 230 pokepk,32:pokepk+1,32:pokepk+40,32:pokepk+41,32
  30. 240 return
  31. 248 :
  32. 249 rem --- print grid-letter ---
  33. 250 cl=55296+(pk-1024)
  34. 255 pokepk,lt:pokecl,2+nm
  35. 260 return
  36. 273 :
  37. 274 rem --- clear home word ---
  38. 275 sysad+24,26,0,"[151][161][162][161][162][161][162][161][162]":sysad+24,26,1,"[163][164][163][164][163][164][163][164]"
  39. 280 sysad+24,2,1,"                  "
  40. 290 return
  41. 348 :
  42. 349 rem --- quit ---
  43. 350 ph$="   [158][209][213][201][212]![159]  [193]re you sure?      y[154]/n":gosub410
  44. 355 poke 781,22:sys 59903:poke 781,23:sys 59903
  45. 360 geta$:ifa$=""then360
  46. 365 ifa$<>"y"then return
  47. 390 print"[147]":poke2048,0:poke44,8:poke53272,23:poke186,8
  48. 394 goto40000
  49. 398 :
  50. 399 rem --- print / center ---
  51. 400 poke781,22:sys59903:sysad+27,22,ph$:return
  52. 405 poke781,23:sys59903:sysad+27,23,ph$:return
  53. 410 poke781,24:sys59903:sysad+27,24,ph$:return
  54. 419 :
  55. 420 sysad+24,11,22,"f1[154] -[196]elete [204]etter      "
  56. 430 sysad+24,4,24,"   f3[154] -[200][197][204][208]!         f7[154] -[209]uit   "
  57. 440 return
  58. 888 :
  59. 889 rem --- oops ---
  60. 890 for x=0to1:poke781,23+x:sys 59903:next
  61. 895 lt=121:co=7:pk=wc-3:gosub250:lt=111:pk=pk+1:gosub250:return
  62. 899 :
  63. 900 rr=0:ph$="oops":forx=1to4:co=1+x
  64. 910 p$=mid$(ph$,x,1):lt=asc(p$):gosub200:pk=pk+2:next
  65. 914 :
  66. 915 fory=1to4:sysad+24,12,23,"[212]hat's not excepted!"
  67. 917 forx=1to100:nextx
  68. 920 sysad+24,12,23,"[154][212]hat's not excepted!"
  69. 922 forx=1to100:nextx:nexty:sysad+27,24,"[212]ry [193]gain...":forx=1to500:nextx
  70. 931 rr=1:if gm=1thenreturn
  71. 932 forx=3to0step-1:pk=wc+x:lt=116:co=11:gosub250:next:pk=wc-2:lt=122
  72. 933 gosub250:pk=pk-1:lt=32:gosub250:xx=0:gosub275:wg=wg-1:return
  73. 1098 :
  74. 1099 rem --- missing link ---
  75. 1100 print"[147]";:wd$(1)="":wd$(2)="":w(1)=1024:w(2)=1655:co=10:lm=1650:wg=1
  76. 1105 gr(2)=1267:gr(3)=1387:gr(4)=1507:gr(6)=1280:gr(7)=1400
  77. 1107 gr(8)=1520:gr(10)=1293:gr(11)=1413:gr(12)=1533
  78. 1110 gr(1)=1147:gr(5)=1160:gr(9)=1173
  79. 1120 gosub1150
  80. 1130 forx=1to2:sys ml+9,4:wd$(x)=w$
  81. 1132 fory=0to3:lt=asc(mid$(w$,(y+1),1))
  82. 1135 pk=w(x)+(y*2):gosub200
  83. 1140 nexty:nextx:gr=1:wd$=wd$(1):uw$(1)=wd$:goto1200
  84. 1149 :
  85. 1150 forx=1to4:print"[151]   [161][162][161][162][161][162][161][162][160][160][160][160][160][161][162][161][162][161][162][161][162][160][160][160][160][160][161][162][161][162][161][162][161][162]"
  86. 1155 print"[151]   [163][164][163][164][163][164][163][164][160][160][160][160][160][163][164][163][164][163][164][163][164][160][160][160][160][160][163][164][163][164][163][164][163][164]":print
  87. 1160 nextx:printtab(7)"?[220][221][146]";tab(27)"[158]_<="
  88. 1165 print"   [154][192][192][192][192][156][193][194][195][196][197][198][199][200][201][202][203][204][205][206][207][208][209][210][211][212][213][214][215][216][217][218][154][192][192][192][192]"
  89. 1170 print"[152]         [158]\]^_[146]":sysad+24,16,18,"[158]>?[220][221][255][223][188][189][146]"
  90. 1175 return
  91. 1199 :
  92. 1200 gosub420:pk=gr(gr)+xx:lt=97:co=7:gosub210
  93. 1210 get lt$:if lt$=""then1210
  94. 1220 if lt$="[134]"then rl$="how.link":gosub3050:goto1210:rem ...f3
  95. 1225 if lt$="[133]"then co=11:gosub2100:rem ...f1
  96. 1230 if lt$="[136]"then goto2700:rem ...f7
  97. 1235 if lt$<"a"orlt$>"z"then1210
  98. 1240 gs$=gs$+lt$:co=5:lt=asc(lt$):gosub200:xx=xx+2
  99. 1250 if xx=8then pr=23:gosub1280:gosub2112:gosub1265
  100. 1255 goto1200
  101. 1260 wg$=str$(wg):sysad+24,4,16,wg$:return
  102. 1265 gosub1300:gosub1260:ifa$<>"[133]"then gs$=""
  103. 1270 return
  104. 1279 :
  105. 1280 for x=0to3:poke781,21+x:sys59903:next:rem ... erase last 4 lines
  106. 1285 return
  107. 1299 :
  108. 1300 ifa$="[133]"thenreturn:rem --- f1
  109. 1305 if mk<1 then gosub 1280:pk=1946:gosub900:if rr=1then rr=0:goto1455
  110. 1315 gosub1280:gosub1350:ifc<>3thengoto1450
  111. 1317 ifc=3then rr=0:gosub2920:if rr=1then rr=0:gosub1455:wg=wg-1:return
  112. 1320 ph$="[217] o u    [215][160][201][160][206][160]!"
  113. 1325 ww$=wd$:wd$=wd$(2):gosub1350:ifc=3thensysad+27,21,ph$:goto2600
  114. 1330 wd$=ww$:gs$="":goto1410
  115. 1349 :
  116. 1350 c=0:forj=1to4:ifmid$(gs$,j,1)=mid$(wd$,j,1)thenc=c+1
  117. 1355 next:return
  118. 1409 :
  119. 1410 gr=gr+1:ifgr>12 then goto2600
  120. 1420 xx=0:gosub1280:return
  121. 1449 :
  122. 1450 gosub2930
  123. 1455 lt=91:co=11:forx=0to6step2:pk=gr(gr)+x:gosub200:next
  124. 1460 rem:gr=gr-1:if gr<1then gr=1
  125. 1465 gosub1280:xx=0:wg=wg-1:return
  126. 1897 end
  127. 1898 :
  128. 1899 rem --- load concatenation ---
  129. 1900 print"[147]":ph$="concatenation":pk=1745:sysad+24,5,15,"[159][204]oading:":co=3
  130. 1910 forx=1tolen(ph$):lt=asc(mid$(ph$,x,1)):gosub200
  131. 1920 pk=pk+3:co=co+1:if co=16then co=3
  132. 1930 next:ph$="[150][194]e right back ...":gosub400
  133. 1940 dv=peek(186):ifdv<8thendv=8
  134. 1950 q$=chr$(34):print"[144]load"q$"concatenation"q$","dv
  135. 1960 print"run"
  136. 1970 poke631,13:poke632,13:poke198,2
  137. 1980 new
  138. 2098 :
  139. 2099 rem --- delete character ---
  140. 2100 ifpk=gr(gr)or pk=1050 thenreturn
  141. 2102 pokepk+80,32:pokepk+81,32
  142. 2103 lt=91:co=11:gosub200:pk=pk-2
  143. 2105 lt=91:co=7:gosub 200:xx=xx-2:ifxx<0thenxx=0:return
  144. 2107 gs$=left$(gs$,(len(gs$)-1)):return
  145. 2108 :
  146. 2109 rem --- 4th letter pause ---
  147. 2110 poke781,pr:sys59903
  148. 2112 poke214,pr:print:print"      f1[154] -delete letter     [210][197][212][213][210][206][154]    "
  149. 2115 geta$:ifa$=""then2115
  150. 2120 ifa$="[133]"then goto2105:rem --- f1
  151. 2125 ifa$<>chr$(13)then2115
  152. 2135 mk=0:sys ml,gs$:ifw$<>gs$then mk=0:goto2175
  153. 2140 mk=1:forx=1to4:lc=asc(mid$(gs$,x,1)):poke56063+(lc-65),7:next:rem alphabet
  154. 2160 :
  155. 2175 wg=wg+1:return
  156. 2188 :
  157. 2189 rem --- prompts ---
  158. 2190 poke214,22:print:print"    f1[154] -delete letter     f3[154] -help  "
  159. 2192 print"   f5[154] -change screens      f7[154] -[209]uit   "
  160. 2195 return
  161. 2298 :
  162. 2299 rem --- main screen ---
  163. 2300 print"[147]";:
  164. 2310 printchr$(159)"[188][191][191][191][191][191][191][191][191][191][191][191][191][191][191][191][191][191][191][191][191][191][191][191][191][191][191][191][191][191][191][191][191][191][191][191][191][191][191][188]";
  165. 2315 fori=1to19
  166. 2320 print"[191]"chr$(31)"[219][219][219][219][219][219][219][219][219][219][219][219][219][219][219][219][219][219][219][219][219][219][219][219][219][219][219][219][219][219][219][219][219][219][219][219][219][219]"chr$(159)"[191]";
  167. 2325 nexti:print"[188][191][191][191][191][191][191][191][191][191][191][191][191][191][191][191][191][191][191][191][191][191][191][191][191][191][191][191][191][191][191][191][191][191][191][191][191][191][191][188]";
  168. 2327 print"[146][150][220][202]athiah[208]roductions[208]resents[220][154]"
  169. 2330 sysad+69:poke214,9:print
  170. 2332 printtab(6)"[156][188][180][180][180][180][180][180][180][180][180][180][180][180][180][180][180][180][180][180][180][180][180][180][180][180][180][180][188]";:forx=1to2
  171. 2334 printspc(12)"[190]"spc(26)"[190]";:next
  172. 2336 printspc(12)"[188][180][180][180][180][180][180][180][180][180][180][180][180][180][180][180][180][180][180][180][180][180][180][180][180][180][180][188]"
  173. 2340 sysad+15,7,32,11,12,32,0:poke214,10:print
  174. 2345 printtab(34)" ":forx=1to2
  175. 2350 printspc(34)" ":next
  176. 2355 printspc(7)"                            "
  177. 2375